home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr51
/
dbview.zip
/
DBVIEW.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-04-01
|
5KB
|
239 lines
Program Read_DBF;
Uses Crt,Dos,Inputs,Screens;
Const Max_Fields = 128;
Max_Header = 4129;
Type
String64 = String[64];
String8 = String[08];
Field_Rec = Record
Name : String[10];
Typ : Char;
Len : Byte;
Dec : Byte;
Off : Integer;
END;
Field_Array = Array [1..Max_Fields] of Field_Rec;
Header = Object
Dbase_File : File of Byte;
Dbase_File_Name : String64;
Last_Update : String8;
Recs : Longint;
Header_length : Integer;
Record_Length : Integer;
Num_Fields : Integer;
Fields : Field_array;
Procedure Init (F_Name:String64);
Function File_Exists:Boolean;
Procedure Display;
Procedure Done;
End;
Function Header.File_Exists;
Var File_Info :SearchRec;
Begin
If Pos('.',Dbase_File_Name)=0 Then
Dbase_File_Name:=Dbase_File_Name+'.DBF';
FindFirst(Dbase_File_Name,Archive,File_Info);
File_Exists :=DosError=0
End;
Procedure Header.Init(F_Name:String64);
Var B : Byte;
Loop : Integer;
Procedure Date;
Begin
Last_Update:='';
Seek(Dbase_File,3);
Read(Dbase_File,B);
Last_Update:=Chr(b);
Seek(Dbase_File,2);
Read(Dbase_File,B);
Last_Update:=Last_Update+Chr(B);
Seek(Dbase_File,1);
Read(Dbase_File,B);
Last_Update:=Last_Update+Chr(b);
End;
Procedure Rec_In_File;
Begin
Seek(Dbase_File,4);
Read(Dbase_File,B);
Recs:= B;
Read(Dbase_File,B);
Recs:= Recs+(B*256);
Read(Dbase_File,B);
Recs:= Recs+(B*65536);
Read(Dbase_File,B);
Recs:= Recs+(B*16777216);
End;
Procedure Len_Of_Rec;
Begin
Seek(Dbase_File,10);
Read(Dbase_File,B);
Record_Length := B;
Record_Length := Record_Length +(B*256);
End;
Procedure Get_Fields;
Var Loop :Byte;
Count:Integer;
Blank :Field_Rec;
Begin
Count:=32;
For Loop:=1 to Num_Fields Do
Begin
Seek(Dbase_File,Count);
B:=1;
Blank.Name:='';
Blank.Typ :=' ';
Blank.len :=0;
Blank.Dec :=0;
Blank.Off :=0;
Fields[Loop]:=Blank;
While B <> 0 Do
Begin
Read(Dbase_File,B);
If B<>0 Then
Fields[Loop].Name:=Fields[Loop].Name+Chr(B);
End;
Inc(Count,11);
Seek(Dbase_File,Count);
Read(Dbase_File,B);
Fields[Loop].Typ:=Chr(B);
Read(Dbase_File,B);
Fields[Loop].Off:=B;
Read(Dbase_File,B);
Fields[Loop].Off:=Fields[Loop].Off+(B*256);
Read(Dbase_File,B);
Fields[Loop].Off:=Fields[Loop].Off+(B*65536);
Read(Dbase_File,B);
Fields[Loop].Off:=Fields[Loop].Off+(B*16777216);
Read(Dbase_File,B);
Fields[Loop].Len:=B;
Read(Dbase_File,B);
Fields[Loop].Dec:=b;
Inc(Count,21);
End;
End;
Begin
Dbase_File_Name:=F_name;
If Not File_Exists Then
Begin
Writeln('File Not Found ',Dbase_File_Name);
Halt;
End;
Assign(Dbase_File,Dbase_File_Name);
Reset(Dbase_File);
Read(Dbase_File,B);
If (B<>3) And (B<>131) Then
Begin
Writeln('Not a Dbase Compatible Database File ');
Halt;
End;
b:=1;
Loop:=0;
While B<> 13 Do
Begin
Seek(Dbase_File,Loop);
Read(dbase_File,B);
Inc(Loop);
End;
Header_Length:=Loop+1;
Num_Fields:=(Header_Length-32) DIV 32;
Date;
Rec_In_File;
Len_Of_Rec;
Num_Fields:=(Header_Length-32) DIV 32;
Get_Fields;
End;
Procedure Header.Display;
Var Loop :Byte;
Total:Integer;
Begin
Writeln(' ');
Writeln('Structure of database : ',Dbase_File_Name);
Writeln('Number of data records : ',Recs);
Writeln('Date of last Update : ',Ord(Last_Update[1]),'/',
Ord(Last_Update[2]),'/',
Ord(Last_Update[3]));
Writeln;
Writeln('Field Name Type Width Dec');
Total:=0;
For Loop:= 1 To Num_fields Do
Begin
Inc(Total,Fields[Loop].Len);
Write(Fields[Loop].Name);
GotoXY(18,WhereY);
Case Fields[Loop].Typ of
'C' : Write('Character');
'L' :Write('Logical');
'N' :Write('Numeric');
'D' :Write('Date');
'M' :Write('Memo');
End;
GotoXY(30,WhereY);Write(Fields[Loop].len:5);
GotoXY(36,WhereY);
IF Fields[Loop].Dec > 0 Then
Write(Fields[Loop].Dec:5);
Writeln;
End;
Writeln('*** Total ***');
GotoXY(30,WhereY-1);Writeln(Total:5);
End;
Procedure Header.Done;
Begin
End;
Function Get_File:String;
Var Ins : Data_Input;
Begin
Esc:=False;
Writeln;
Writeln('dbview, Dbase 3+ File Structure Viewer ');
Writeln('Copyright 1992 U.J.Sear ');
Writeln;
Writeln('Usage :- dbview << dbase file name >> ');
Write('Please Specify File Name ');
Inverse_Video;
Get_File:=Ins.Get_Word(WhereX,WhereY,'',12);
Inverse_Video;
GotoXY(1,WhereY);Writeln(' ');
GotoXY(1,WhereY-2);Writeln(' ');
GotoXY(1,WhereY-2);
End;
Var H :Header;
Procedure Do_it;
Begin
With H DO
Begin
IF ParamCount < 1 Then
Init(Get_File)
Else
Init(ParamStr(1));
Display;
End;
End;
Begin
Do_it;
End.